home *** CD-ROM | disk | FTP | other *** search
/ Info-Mac 3 / Info_Mac_1994-01.iso / Text Processing / Alpha 5.63 / Tcl / SystemCode / fill.tcl < prev    next >
Encoding:
Text File  |  1993-09-12  |  2.8 KB  |  132 lines  |  [TEXT/ALFA]

  1. #=============================================================================
  2. #    'Fill' routines.
  3. #=============================================================================
  4.  
  5. proc fillParagraph {} {
  6.     set pos [getPos]
  7.     set start [paraStart $pos] 
  8.     set finish [paraFinish $pos]
  9.     goto $start
  10.     set text [fillText $start $finish]
  11.     replaceText $start $finish $text "\r"
  12.     goto $pos
  13. }
  14.  
  15. proc fillRegion {} {
  16.     set start [lineStart [getPos]]
  17.     set finish [selEnd]
  18.     goto $start
  19.     set text [fillText $start $finish]
  20.     replaceText $start $finish $text "\r"
  21. }
  22.     
  23. proc wrapParagraph {} {
  24.     set pos [getPos]
  25.     set start [paraStart $pos] 
  26.     set finish [paraFinish $pos]
  27.     goto $start
  28.     wrapText $start $finish
  29.     goto $pos
  30. }
  31.  
  32. proc wrapRegion {} {
  33.     set start [lineStart [getPos]]
  34.     set finish [selEnd]
  35.     if {$start == $finish} {
  36.         set finish [maxPos]
  37.     }
  38.     wrapText $start $finish
  39. }
  40.     
  41. proc paraStart {pos} {
  42.     set res [search -n -f 0 -r 1 {^[ \t]*$} $pos 0]
  43.     if {![string length $res]} {return 0}
  44.     return [nextLineStart [lindex $res 0]]
  45. }
  46.  
  47.  
  48. proc paraFinish {pos} {
  49.     set end [maxPos]
  50.     set res [search -n -f 1 -r 1 {^[ \t]*$} $pos $end]
  51.     if {![string length $res]} {return $end}
  52.     return [lindex $res 0]
  53. }
  54.  
  55.  
  56. proc oldParaStart {pos} {
  57.     set pos [lineStart $pos]
  58.     while {$pos > 0} {
  59.         set back [lineStart [expr $pos-1]]
  60.         if {$back < 0} {return 0}
  61.         if {[regexp "^\[ \t\]*\r$" [getText $back $pos]]} {return $pos}
  62.         set pos $back
  63.     }
  64.     return 0
  65. }
  66.  
  67.  
  68. proc oldParaFinish {pos} {
  69.     set end [maxPos]
  70.     while {$pos < $end} {
  71.         set next [nextLineStart $pos]
  72.         if {$pos == "-1"} {return $end}
  73.         if {[regexp "^\[ \t\]*\r$" [getText $pos $next]]} {return $pos}
  74.         set pos $next
  75.     }
  76.     return $end
  77. }
  78.  
  79.  
  80. # Remove text from window, transform, and insert back into window.
  81. proc fillText {from to} {
  82.     set text [getText $from $to]
  83.     regsub -all "\[ \t\r\]+" $text " " text
  84.     regsub -all {\. } $text {.  } text
  85.     return [string trim [breakIntoLines $text]]
  86. }
  87.  
  88. proc lineToParagraph {} {
  89.     global fillColumn
  90.     global leftFillColumn
  91.     saveVars
  92.     set fillColumn 10000
  93.     set leftFillColumn 0
  94.     fillRegion
  95.     restoreVars
  96. }
  97.  
  98. proc paragraphToLine {} {
  99.     global fillColumn
  100.     global leftFillColumn
  101.     saveVars
  102.     set fillColumn 75
  103.     set leftFillColumn 0
  104.     fillRegion
  105.     restoreVars
  106. }
  107.  
  108.  
  109. #set sentEnd {[.!?](\r| +)}
  110. set sentEnd {(\r\r|[.!?](\r| +))}
  111. set sentBeg {[\r ][A-Z]}
  112.  
  113. proc nextSentence {} {
  114.     global sentBeg sentEnd
  115.     if {![catch {search -f 1 -r 1 $sentEnd [getPos]} mtch]} {
  116.         if {![catch {search -f 1 -r 1 -i 0 $sentBeg [expr [lindex $mtch 1]-1]} mtch]} {
  117.             goto [expr [lindex $mtch 0]+1]
  118.         }
  119.     }
  120. }
  121.  
  122.  
  123. proc prevSentence {} {
  124.     global sentBeg sentEnd
  125.     if {[catch {search -f 0 -r 1 $sentBeg [expr [getPos]-2]} mtch]} return
  126.     if {![catch {search -f 0 -r 1 $sentEnd [lindex $mtch 1]} mtch]} {
  127.         if {![catch {search -f 1 -r 1 -i 0 $sentBeg [expr [lindex $mtch 1]-1]} mtch]} {
  128.             goto [expr [lindex $mtch 0]+1]
  129.         }
  130.     }
  131. }
  132.